home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pasprog.EXE / EMSI.ZIP / EMSI.PAS
Pascal/Delphi Source File  |  1991-09-30  |  11KB  |  477 lines
  1. (*
  2.   Hope ya don't mind me responding via NetMail instead of
  3. the Pascal echo but as you may have noticed the code takes 6 messages!  The
  4. following code is "fairly" EMSI compatible (not sure if it's IEMSI compatinle
  5. but it should be). 
  6. *)
  7. {********* Part 1 of 6 ****************************************}
  8.  
  9. Uses
  10.   DOS,CRT;
  11.  
  12. Type
  13.   HexString = String[4];
  14.  
  15. Const
  16.   FingerPrint          = '{EMSI}';
  17.   System_Address       = '3:690/626.6';     { Your address }
  18.   Password             = 'ABCD1234';        { Session password }
  19.   Link_Codes           = '{8N1}';           { Modem setup }
  20.   Compatibility_Codes  = '{ZMO}';           { Z-Modem }
  21.   Mailer_Product_Code  = '{00}';
  22.   Mailer_Name          = 'PM';
  23.   Mailer_Version       = '1.00';
  24.   Mailer_Serial_Number = '{Beta}';
  25.  
  26.   EMSI_INQ : String = '**EMSI_INQC816';
  27.   EMSI_REQ : String = '**EMSI_REQA77E';
  28.   EMSI_ACK : String = '**EMSI_ACKA490';
  29.   EMSI_NAK : String = '**EMSI_NAKEEC3';
  30.  
  31. Var
  32.   EMSI_DAT : String;            { NOTE : EMSI_DAT has no maximum length }
  33.   Length_EMSI_DAT : HexString;  { Expressed in Hexidecimal }
  34.  
  35.   Packet : String;
  36.   Rec_EMSI_DAT : String;        { EMSI_DAT sent by the answering system }
  37.   Len_Rec_EMSI_DAT : Word;
  38.  
  39.   Len,
  40.   CRC : HexString;
  41.  
  42.   R : Registers;
  43.   C : Char;
  44.   Loop,ComPort,TimeOut,Tries : Byte;
  45.   Temp : String;
  46.  
  47. {****  String functions ****}
  48.  
  49. Function Up_Case(St : String) : String;
  50. Begin
  51.   For Loop := 1 to Length(St) do
  52.     St[Loop] := Upcase(St[Loop]);
  53.  
  54.   Up_Case := St;
  55. End;
  56.  
  57. {****  Mathematical Functions ****}
  58.  
  59. function Hex(i : Word) : HexString;
  60. const
  61.   hc : array[0..15] of Char = '0123456789ABCDEF';
  62. var
  63.   l, h : Byte;
  64. begin
  65.   l := Lo(i);
  66.   h := Hi(i);
  67.   Hex[0] := #4;          { Length of String = 4 }
  68.   Hex[1] := hc[h shr 4];
  69.   Hex[2] := hc[h and $F];
  70.   Hex[3] := hc[l shr 4];
  71.   Hex[4] := hc[l and $F];
  72. end {Hex} ;
  73.  
  74. Function Power(Base,E : Byte) : Longint;
  75. Begin
  76.   Power := Round(Exp(E * Ln(Base) ));
  77. End;
  78.  
  79. Function Hex2Dec(HexStr : String) : Longint;
  80.  
  81. { Maximum hexidecimal number that can be handled is about 'FFFFFF' }
  82. { Do not start the hexidecimal number with a dollar sign '$'       }
  83.  
  84. Var
  85.   I,HexBit : Byte;
  86.   Temp : Longint;
  87.   Code : integer;
  88.  
  89. Begin
  90.   Temp := 0;
  91.   For I := Length(HexStr) downto 1 do
  92.   Begin
  93.     If HexStr[I] in ['A','a','B','b','C','c','D','d','E','e','F','f'] then
  94.       Val('$' + HexStr[I],HexBit,Code)
  95.         else
  96.           Val(HexStr[I],HexBit,Code);
  97.     Temp := Temp + HexBit * Power(16,Length(HexStr) - I);
  98.   End;
  99.   Hex2Dec := Temp;
  100. End;
  101.  
  102. {********************* End of part 1 *****************}
  103.  
  104. {***************** Part 2 of 6 *******************}
  105.  
  106. Function Bin2Dec(BinStr : String) : Longint;
  107.  
  108. { Maximum is 16 bits, though a requirement for more would be   }
  109. { easy to accomodate.  Leading zeroes are not required. There  }
  110. { is no error handling - any non-'1's are taken as being zero. }
  111.  
  112. Var
  113.   I : Byte;
  114.   Temp : Longint;
  115.   BinArray : Array[0..15] of char;
  116.  
  117. Begin
  118.   For I := 0 to 15 do
  119.     BinArray[I] := '0';
  120.  
  121.   For I := 0 to Pred(Length(BinStr)) do
  122.     BinArray[I] := BinStr[Length(BinStr) - I];
  123.  
  124.   Temp := 0;
  125.  
  126.   For I := 0 to 15 do
  127.     If BinArray[I] = '1' then inc(Temp,Round(Exp(I * Ln(2))));
  128.  
  129.   Bin2Dec := Temp;
  130. End;
  131.  
  132. function CRC16(s:string):word;  { By Kevin Cooney }
  133. var
  134.   crc : longint;
  135.   t,r : byte;
  136. begin
  137.   crc:=0;
  138.   for t:=1 to length(s) do
  139.   begin
  140.     crc:=(crc xor (ord(s[t]) shl 8));
  141.     for r:=1 to 8 do
  142.       if (crc and $8000)>0 then
  143.         crc:=((crc shl 1) xor $1021)
  144.           else
  145.             crc:=(crc shl 1);
  146.   end;
  147.   CRC16:=(crc and $FFFF);
  148. end;
  149.  
  150. {**** FOSSIL Routines ****}
  151.  
  152. Procedure InitPort(Baud : Integer; Parity : Char; CharLength,StopBits: Byte);
  153. Begin
  154.   Temp := '';
  155.  
  156.   Case Baud of 19200 : Temp := '000';
  157.                 9600 : Temp := '111';
  158.                 4800 : Temp := '110';
  159.                 2400 : Temp := '101';
  160.                 1200 : Temp := '100';
  161.                  300 : Temp := '010';
  162.   End;
  163.  
  164.   Case UpCase(Parity) of 'N' : Temp := Temp + '00';
  165.                          'E' : Temp := Temp + '11';
  166.                          'O' : Temp := Temp + '01';
  167.   End;
  168.  
  169.   If StopBits = 1 then Temp := Temp + '0' else Temp := Temp + '1';
  170.  
  171.   Case CharLength of 8 : temp := Temp + '11';
  172.   End;
  173.  
  174.   R.AH := $00;
  175.   R.AL := Bin2Dec(Temp);
  176.   R.DX := Pred(COMPort);
  177.   Intr($14,R);
  178. End;
  179.  
  180. Procedure Write2Port(Strg : String);
  181. Begin
  182.   For Loop := 1 to Length(Strg) do
  183.   Begin
  184.     R.AH := $01;
  185.     R.AL := Ord(Strg[Loop]);
  186.     R.DX := Pred(Comport);
  187.     Intr($14,R);
  188.   End;
  189. End;
  190.  
  191. {******************* End of part 2 ***********************}
  192.  
  193. {***************** Part 3 of 6 *****************}
  194.  
  195. Function ReadKeyFromPort : Char;
  196. Begin
  197.   R.AH := $02;
  198.   R.DX := Pred(Comport);
  199.   Intr($14,R);
  200.   If R.AH = $00 then ReadKeyFromPort := Char(R.AL);
  201. End;
  202.  
  203. Function StatusReq : Byte;
  204. Begin
  205.   R.AH := $03;
  206.   R.DX := Pred(Comport);
  207.   Intr($14,R);
  208.   StatusReq := R.AX;
  209. End;
  210.  
  211. Function FossilPresent : Boolean;
  212. Begin
  213.   R.AH := $04;
  214.   R.DX := Pred(COMport);
  215.   Intr($14,R);
  216.   If R.AX = $1954 then FossilPresent := TRUE else FossilPresent := FALSE;
  217. End;
  218.  
  219. Procedure RaiseDTR;
  220. Begin
  221.   R.AH := $06;
  222.   R.AL := $01;
  223.   R.DX := Pred(Comport);
  224.   Intr($14,R);
  225. End;
  226.  
  227. Procedure LowerDTR;
  228. Begin
  229.   R.AH := $06;
  230.   R.AL := $00;
  231.   R.DX := Pred(Comport);
  232.   Intr($14,R);
  233. End;
  234.  
  235. Procedure Purge_Input;
  236. Begin
  237.   R.AH := $0A;
  238.   R.DX := Pred(Comport);
  239.   Intr($14,R);
  240. End;
  241.  
  242. Function CharInBuffer : Boolean;
  243. Begin
  244.   R.AH := $0C;
  245.   R.DX := Pred(COMport);
  246.   Intr($14,R);
  247.   If R.AX = $FFFF then
  248.     CharInBuffer := FALSE
  249.       else
  250.         CharInBuffer := TRUE;
  251. End;
  252.  
  253. {**************** End of Part 3 *********************}
  254.  
  255. {************* Part 4 of 6 ***************}
  256.  
  257. function FOSSIL_name : string;
  258. { Returns ASCII description of FOSSIL driver in use. }
  259. { Returns empty string if no FOSSIL was detected.    }
  260.  
  261. type
  262.   ary128 = array[1..128] of char;
  263.   aryPtr = ^ary128;
  264.   FOSSIL_info_record_type = record
  265.     size      : word;    { size of the structure in bytes      }
  266.     majver    : byte;    { major FOSSIL driver spec            }
  267.     minver    : byte;    { minor FOSSIL driver spec            }
  268.     ident     : aryPtr;  { far pointer to ASCII ID string      }
  269.     inbuffer  : word;    { size of the input buffer in bytes   }
  270.     infree    : word;    { number of bytes left in buffer      }
  271.     outbuffer : word;    { size of the output buffer in bytes  }
  272.     outfree   : word;    { number of bytes left in the buffer  }
  273.     width     : byte;    { width of screen on this adapter     }
  274.     height    : byte;    { height of screen on this adapter    }
  275.     baud      : byte     { actual baud rate, computer to modem }
  276.   end;
  277.  
  278. var
  279.   i, j : byte;
  280.   f    : FOSSIL_info_record_type;
  281.   temp : string;
  282.  
  283. begin
  284.   j := Pred(COMport);
  285.   repeat
  286.     fillchar(f, sizeof(f), #0);
  287.     fillchar(r, sizeof(r), #0);
  288.     temp := '';
  289.     r.AH := $1B;
  290.     r.CX :=  19; { size of FOSSIL_info_record_type }
  291.     r.DX :=   j; { COM port              }
  292.     r.ES := seg(f);
  293.     r.DI := ofs(f);
  294.     intr($14,r);
  295.  
  296.     if r.AX = 19 then { looks as if FOSSIL was detected? }
  297.     begin
  298.       i := 1;
  299.       repeat
  300.         if f.ident^[i] <> #0 then temp := temp + f.ident^[i];
  301.         inc(i)
  302.       until (f.ident^[i] = #0) or (i = 128)
  303.     end else inc(j)
  304.  
  305.   until (temp <> '') or (j > 4); { only check COM1-COM4 }
  306.  
  307.   FOSSIL_name := temp
  308.  
  309. end; { FOSSIL_name }
  310.  
  311. Procedure Hangup;
  312. Begin
  313.     Write2Port('+++'+#13);
  314. End;
  315. {**** EMSI Handshake Routines ****}
  316.  
  317. Procedure Create_EMSI_DAT;
  318. Begin
  319.   FillChar(EMSI_DAT,255,' ');
  320.  
  321.   EMSI_DAT := FingerPrint + '{' + System_Address + '}{'+ Password + '}' +
  322.               Link_Codes + Compatibility_Codes + Mailer_Product_Code +
  323.               '{' + Mailer_Name + '}{' + Mailer_Version + '}' +
  324.               Mailer_Serial_Number;
  325.  
  326.   Length_EMSI_DAT := Hex(Length(EMSI_DAT));
  327. End;
  328.  
  329. Function Carrier_Detected : Boolean;
  330. Begin
  331.   TimeOut := 20;   { Wait approximately 20 seconds }
  332.   Repeat
  333.     Delay(1000);
  334.     Dec(TimeOut);
  335.   Until (TimeOut = 0) or (Lo(StatusReq) and $80 = $80);
  336.  
  337.   If Timeout = 0 then
  338.     Carrier_Detected := FALSE
  339.       else
  340.         Carrier_Detected := TRUE;
  341. End;
  342.  
  343. {************* End of part 4 *****************}
  344.  
  345. {************* Part 5 of 6 ****************}
  346.  
  347. Function Get_EMSI_REQ : Boolean;
  348. Begin
  349.   Temp := '';
  350.   Purge_Input;
  351.  
  352.   Repeat
  353.     C := ReadKeyfromPort;
  354.     If (C <> #10) and (C <> #13) then Temp := Temp + C;
  355.   Until Length(Temp) = Length(EMSI_REQ);
  356.  
  357.   If Up_Case(Temp) = EMSI_REQ then
  358.     get_EMSI_REQ := TRUE
  359.       else
  360.         get_EMSI_REQ := FALSE;
  361. End;
  362.  
  363. Procedure Send_EMSI_DAT;
  364. Begin
  365.   CRC := Hex(CRC16('EMSI_DAT' + Length_EMSI_DAT + EMSI_DAT));
  366.   Write2Port('**EMSI_DAT' + Length_EMSI_DAT + EMSI_DAT + CRC);
  367. End;
  368.  
  369. Function Get_EMSI_ACK : Boolean;
  370. Begin
  371.   Temp := '';
  372.  
  373.   Repeat
  374.     C := ReadKeyfromPort;
  375.     If (C <> #10) and (C <> #13) then Temp := Temp + C;
  376.   Until Length(Temp) = Length(EMSI_ACK);
  377.  
  378.   If Up_Case(Temp) = EMSI_ACK then
  379.     get_EMSI_ACK := TRUE
  380.       else
  381.         get_EMSI_ACK := FALSE;
  382. End;
  383.  
  384. Procedure Get_EMSI_DAT;
  385. Begin
  386.   Temp := '';
  387.   For Loop := 1 to 10 do                  { Read in '**EMSI_DAT' }
  388.     Temp := Temp + ReadKeyfromPort;
  389.  
  390.   Delete(Temp,1,2);                       { Remove the '**'      }
  391.  
  392.   Len := '';
  393.   For Loop := 1 to 4 do                   { Read in the length   }
  394.     Len := Len + ReadKeyFromPort;
  395.  
  396.   Temp := Temp + Len;
  397.  
  398.   Len_Rec_EMSI_DAT := Hex2Dec(Len);
  399.  
  400.   Packet := '';
  401.   For Loop := 1 to Len_Rec_EMSI_DAT do    { Read in the packet   }
  402.     Packet := Packet + ReadKeyfromPort;
  403.  
  404.   Temp := Temp + Packet;
  405.  
  406.   CRC := '';
  407.   For Loop := 1 to 4 do                   { Read in the CRC      }
  408.     CRC := CRC + ReadKeyFromPort;
  409.  
  410.   Rec_EMSI_DAT := Packet;
  411.  
  412.   Writeln('Rec_EMSI_DAT = ',Rec_EMSI_DAT);
  413.  
  414.   If Hex(CRC16(Temp)) <> CRC then
  415.     Writeln('The recieved EMSI_DAT is corrupt!!!!');
  416. End;
  417.  
  418. {*********** End of part 5 *************}
  419.  
  420. {********* Part 6 of 6 ****************}
  421.  
  422. Begin
  423.   { Assumes connection has been made at this point }
  424.  
  425.   Tries := 0;
  426.   Repeat
  427.     Write2Port(EMSI_INQ);
  428.     Delay(1000);
  429.     Inc(Tries);
  430.   Until (Get_EMSI_REQ = TRUE) or (Tries = 5);
  431.  
  432.   If Tries = 5 then
  433.   Begin
  434.     Writeln('Host system failed to acknowledge the inquiry sequence.');
  435.     Hangup;
  436.     Halt;
  437.   End;
  438.  
  439.   { Used for debugging }
  440.   Writeln('Boss has acknowledged receipt of EMSI_INQ');
  441.  
  442.   Send_EMSI_DAT;
  443.  
  444.   Tries := 0;
  445.   Repeat
  446.     Inc(Tries);
  447.   Until (Get_EMSI_ACK = True) or (Tries = 5);
  448.  
  449.   If Tries = 5 then
  450.   Begin
  451.     Writeln('Host system failed to acknowledge the EMSI_DAT packet.');
  452.     Hangup;
  453.     halt;
  454.   End;
  455.  
  456.   Writeln('Boss has acknowledged receipt of EMSI_DAT');
  457.  
  458.   Get_EMSI_DAT;
  459.   Write2Port(EMSI_ACK);
  460.  
  461.   { Normally the file transfers would start at this point }
  462.   Hangup;
  463. End.
  464.  
  465. {********** End of part 6 (and program) **********}
  466. (*
  467. Ok.. If ya need some help feel free to ask.  The FOSSIL interfacing code has
  468. been included. You'll need a FOSSIL for it to work.  The code probably won't
  469. work as is.  The areas that will need work on is the actual port
  470. initialization (procedure is included though) and connecting to the host
  471. system. 
  472. Let me know how it goes.
  473.  
  474. Seeya,
  475.   Chris.
  476. *)
  477.